home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / mrgsort.zip / MRGSORT.PAS < prev    next >
Pascal/Delphi Source File  |  1990-04-18  |  5KB  |  121 lines
  1. UNIT mrgsort;
  2. (* By C.B. Falconer, public domain.  This is based on a description *)
  3. (* in Sedgewicks 'Algorithms', but modified for isolation to a TP   *)
  4. (* unit, with a generalized linkage to the items to sort.           *)
  5.  
  6. (* Since the 'info' field of a linknode is never used here, the     *)
  7. (* actual record may be designed as the application demands, so     *)
  8. (* long as the FIRST item in it is the 'next' pointer.  Care must   *)
  9. (* then be taken not to modify the info field of 'null'.            *)
  10.  
  11. (* The user defined 'greater' function will receive whatever type   *)
  12. (* of pointer is passed in to sort, and never the null pointer.     *)
  13.  
  14. (* The list to be sorted must be terminated with a 'next' that      *)
  15. (* contains the value 'null', and it must be the null defined here. *)
  16.  
  17. INTERFACE
  18.  
  19.   TYPE
  20.    greaterf     = FUNCTION(thing, than : pointer) : boolean;
  21.  
  22.   VAR
  23.     null        : pointer;   (* used as NIL substitute for end marks *)
  24.  
  25.   FUNCTION sort(root : pointer; greater : greaterf) : pointer;
  26.   (* This provides a logical level for passing in the 'greater' proc. *)
  27.   (* note that these procedures do not use the header link, i.e. the  *)
  28.   (* pointers they receive carry actual list data.  The pointers will *)
  29.   (* later be defined as holding only the next and an 'info' pointer. *)
  30.   (* The info pointer will not be used here, so can be of any type.   *)
  31.  
  32. IMPLEMENTATION
  33.  
  34.   TYPE
  35.     link        = ^linknode;
  36.     linknode    = RECORD
  37.       next        : link;
  38.       (* Actual items have information following 'next' *)
  39.       END;
  40.   
  41.   (* 1---------------1 *)
  42.  
  43.   FUNCTION sort(root : pointer; greater : greaterf) : pointer;
  44.  
  45.     (* 2---------------2 *)
  46.   
  47.     FUNCTION msort(root : link) : link;                  (* RECURSIVE *)
  48.     (* The use of the terminal sentinal 'null' with null^.next = null *)
  49.     (* is especially handy in the split process.  This avoids having  *)
  50.     (* any special processing to handle the list ends.                *)
  51.   
  52.     (* The critical thing for using generalized pointers is that the  *)
  53.     (* FIRST field in the record should be the 'next' pointer.  This  *)
  54.     (* code uses nothing else outside the 'greater' function.         *)
  55.  
  56.     (* Stack usage per recursion level should be 4 pointers and one   *)
  57.     (* near stack marker, or about 22 bytes per level.  Sorting 65000 *)
  58.     (* items thus should not require over 352 bytes of stack.  (TP5)  *)
  59.   
  60.       VAR
  61.         left, right : link;
  62.   
  63.       (* 3---------------3 *)
  64.   
  65.       FUNCTION merge(a, b : link) : link;
  66.       (* here we temporarily reuse null as a list header, *)
  67.       (* in addition to its normal use as a terminator.   *)
  68.       (* Care is taken to NEVER pass null to 'greater'.   *)
  69.   
  70.         VAR
  71.           c      : link;
  72.   
  73.         BEGIN (* merge *)
  74.         c := null;       (* null^.next holds start of list for now *)
  75.         REPEAT
  76.           (* WARNING - short circuit evaluation assumed here *)
  77. {}        IF (b = null) OR ((a <> null) AND greater(b, a)) THEN BEGIN
  78.             c^.next := a; c := a; a := a^.next; END
  79.           ELSE BEGIN
  80.             c^.next := b; c := b; b := b^.next; END;
  81.         UNTIL c = null;
  82.         merge := link(null)^.next;
  83.         link(null)^.next := null;            (* restore null *)
  84.         END; (* merge *)
  85.   
  86.       (* 3---------------3 *)
  87.   
  88.       PROCEDURE split(root : link; VAR left, right : link);
  89.       (* splits the list into two null terminated lists *)
  90.   
  91.         BEGIN (* split *)
  92.         left := root;                      (* this is all settled *)
  93.         right := root^.next^.next^.next;
  94.         WHILE right <> null DO BEGIN
  95.           (* advance the left pointer 1, the right pointer 2 *)
  96.           root := root^.next; right := right^.next^.next; END;
  97.         right := root^.next;            (* this has moved halfway *)
  98.         root^.next := null;        (* and terminate the left list *)
  99.         END; (* split *)
  100.   
  101.       (* 3---------------3 *)
  102.   
  103.       BEGIN (* msort *)
  104.       IF root^.next = null THEN msort := root
  105.       ELSE BEGIN
  106.         split(root, left, right);
  107.         msort := merge(msort(left), msort(right)); END;
  108.       END; (* msort *)
  109.   
  110.     (* 2---------------2 *)
  111.  
  112.     BEGIN (* sort *)
  113.     sort := link(msort(link(root)));
  114.     END; (* sort *)
  115.   
  116.   (* 1---------------1 *)
  117.  
  118.   BEGIN (* mrgsort initialization *)
  119.   new(link(null)); link(null)^.next := null;
  120.   END.   (* mrgsort initialization *)
  121. ½@